Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/info/info.frm

Text File | 1995-05-08 | 7KB | 218 lines

VERSION 2.00
Begin Form frmDlgInfo
   BorderStyle     =   3  'Fixed Double
   Caption         =   "About name of program"
   ClientHeight    =   3465
   ClientLeft      =   1320
   ClientTop       =   1785
   ClientWidth     =   7695
   ClipControls    =   0   'False
   Height          =   3870
   Left            =   1260
   LinkMode        =   1  'Source
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3465
   ScaleWidth      =   7695
   Top             =   1440
   Width           =   7815
   Begin CommandButton Command1
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
   Begin Label Label7
      Alignment       =   2  'Center
      Caption         =   "icon !"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   0
      Visible         =   0   'False
      Width           =   615
   End
   Begin Image Image1
      Height          =   615
      Left            =   240
      Top             =   360
      Width           =   615
   End
   Begin Label Label6
      AutoSize        =   -1  'True
      Caption         =   "anything"
      Height          =   195
      Left            =   1080
      TabIndex        =   9
      Top             =   1560
      Width           =   735
   End
   Begin Label Label5
      AutoSize        =   -1  'True
      Caption         =   "anything"
      Height          =   195
      Left            =   1080
      TabIndex        =   8
      Top             =   1200
      Width           =   735
   End
   Begin Label lblRes
      Caption         =   "lblRes"
      Height          =   255
      Left            =   3360
      TabIndex        =   7
      Top             =   3120
      Width           =   3015
   End
   Begin Label lblKB
      Caption         =   "lblKB"
      Height          =   255
      Left            =   3360
      TabIndex        =   6
      Top             =   2760
      Width           =   3015
   End
   Begin Label lblModus
      Caption         =   "lblModus"
      Height          =   255
      Left            =   1080
      TabIndex        =   5
      Top             =   2400
      Width           =   6495
   End
   Begin Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Systemresources:"
      Height          =   195
      Left            =   1080
      TabIndex        =   4
      Top             =   3120
      Width           =   1500
   End
   Begin Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Memory:"
      Height          =   195
      Left            =   1080
      TabIndex        =   3
      Top             =   2760
      Width           =   720
   End
   Begin Line Line1
      BorderWidth     =   2
      X1              =   1080
      X2              =   6360
      Y1              =   2040
      Y2              =   2040
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      Caption         =   "copyright note"
      Height          =   195
      Left            =   1080
      TabIndex        =   2
      Top             =   720
      Width           =   1230
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      Caption         =   "name of program"
      Height          =   195
      Left            =   1080
      TabIndex        =   1
      Top             =   360
      Width           =   1425
   End
End
DefInt A-Z
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags) As Long
Declare Function GetWinFlags Lib "Kernel" () As Long
Declare Function GetVersion Lib "Kernel" () As Long
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer

Const WF_STANDARD = &H10
Const WF_ENHANCED = &H20
Const WF_80x87 = &H400
Const SM_DEBUG = 22
Const GFSR_SYSTEMRESOURCES = &H0

'correct SysMenu for dlgs
Const MF_BYPOSITION = &H400
Declare Function GetSystemMenu Lib "User" (ByVal hWnd As Integer, ByVal bRevert As Integer) As Integer
Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer

Const KEY_ESCAPE = &H1B

Sub Command1_Click ()
    Unload frmDlgInfo
End Sub

Sub Command1_KeyPress (KeyAscii As Integer)
    If KeyAscii = KEY_ESCAPE Then Unload frmDlgInfo
End Sub

Sub Form_Load ()
Dim WinFlags As Long
Dim Mode As String
Dim Version As Long
Dim lKBfree As Long
Dim KBfree As String
Dim SystemMetrics As Integer
    ' Dialog Boxes should only have Move and Close items
    ' in their System menus', so remove the others.
    Remove_Items_From_Sysmenu frmDlgInfo

    'fill the mode label...
    Mode = "Windows version "

    ' Get current Windows configuration
    Version = GetVersion()
    Mode = Mode + Format(LOBYTE(LOWORD(Version)), "#") + "." + Format(HIBYTE(LOWORD(Version)), "#") + "  -  "
    WinFlags = GetWinFlags()
    If WinFlags And WF_ENHANCED Then Mode = Mode + "Enhanced Mode" Else Mode = Mode + "Standard Mode"
    SystemMetrics = GetSystemMetrics(SM_DEBUG)
    If SystemMetrics <> 0 Then Mode = Mode + " (DEBUG)"
    lblModus.Caption = Mode

    lKBfree = GetFreeSpace(0) \ 1024
    KBfree = Format(lKBfree, "#,#")
    lblKB.Caption = KBfree + " KB free"

    lblRes.Caption = Format(GetFreeSystemResources(GFSR_SYSTEMRESOURCES), "#") + " % free"
End Sub

Function HIBYTE (ShortInt As Integer) As Integer
    HIBYTE% = ShortInt% \ 256
End Function

Function HIWORD (LongInt As Long) As Integer
    HIWORD% = LongInt& \ 65536
End Function

Function LOBYTE (ShortInt As Integer) As Integer
    LOBYTE% = ShortInt% Mod 256
End Function

Function LOWORD (LongInt As Long) As Integer
    LOWORD% = LongInt& Mod 65536
End Function

Sub Remove_Items_From_Sysmenu (A_Form As Form)
    ' Obtain the handle to the forms System menu
    '
    HSysMenu = GetSystemMenu(A_Form.hWnd, 0)

    ' Remove all but the MOVE and CLOSE options.  The menu items
    ' must be removed starting with the last menu item.
    '
    R = RemoveMenu(HSysMenu, 8, MF_BYPOSITION) 'Switch to
    R = RemoveMenu(HSysMenu, 7, MF_BYPOSITION) 'Separator
    R = RemoveMenu(HSysMenu, 5, MF_BYPOSITION) 'Separator
End Sub